home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_FileRunner.idb / usr / freeware / lib / FileRunner2.5 / frftp.z / frftp
Encoding:
Text File  |  1999-01-26  |  2.2 KB  |  96 lines

  1. #! /bin/sh
  2. # the next line restarts using wish \
  3. exec wish8.0 $0 wish8.0 $*
  4.  
  5.  
  6. proc ShowWindow { realhost file } {
  7.  
  8.   wm title . "FileRunner [file tail $realhost$file] download"
  9.   wm iconname . "FR [file tail $realhost$file] download"
  10.   wm protocol . WM_DELETE_WINDOW { exit 0 }
  11.  
  12.   frame .top -bd 0
  13.   label .top.stat -text "Hang On..." -width 50 -wraplength 10c -pady 10
  14.   button .top.abort -text "Cancel" -command "exit 0"
  15.   pack .top
  16.   pack .top.stat -side top -expand 1 -fill x
  17.   pack .top.abort -side bottom 
  18. }
  19.  
  20. proc Log { text } {
  21.   .top.stat configure -text "$text"
  22.   update
  23. }
  24.  
  25. proc LogStatusOnly { text } {
  26.   Log $text
  27. }
  28.  
  29. proc LogSilent { text } { }
  30.  
  31. proc PopError { error } {
  32.   tk_dialog .apop "**Error**" "$error" "" 0 "OK"
  33.   exit 1
  34. }
  35.  
  36. proc PopWarn { error } {
  37.   tk_dialog .apop "Warning" "$error" "" 0 "OK"
  38. }
  39.  
  40. #puts "$argv"
  41. set glob(lib_fr) [lindex $argv 1]
  42.  
  43. set r [catch { source $glob(lib_fr)/ftp.tcl } out]
  44. if { $r != 0 } {
  45.   PopError "Error loading FTP code:\n\n$out"
  46. }
  47.  
  48. set r [catch { load $glob(lib_fr)/ext.so Ext } out]
  49. if { $r != 0 } {
  50.   PopError "Error loading FileRunner binary extensions code:\n\n$out"
  51. }
  52.  
  53. proc FTP_Transfer { wish lib_fr timeout ftpI host user passwd realhost file_src file_dest exp_size resume } {
  54.   Log "Opening FTP connection to $realhost..."
  55.   set r [catch { FTP_OpenSession $ftpI $host $user $passwd $realhost } out ]
  56.   if {$r} {
  57.     PopError "FTP connecting: $out"
  58.   } else {
  59.     Log "FTP connection to $realhost open"
  60.   }
  61.   set r [catch { FTP_GetFile $ftpI $file_src $file_dest $exp_size $resume} out]
  62.   if {$r} {
  63.     PopError "FTP transfer failed: $out"
  64.   } else {
  65.     #Log "FTP transfer OK"
  66.     after 2000
  67.   }
  68.   exit 0
  69. }
  70.  
  71. proc Try { tryscript excuse alsoPrintErrorInfo } {
  72.   #puts "Try:$tryscript"
  73.   set r [catch {uplevel $tryscript} outp ]
  74.   if {$r == 0} {return 0}
  75.   if {$alsoPrintErrorInfo} {
  76.     if {$excuse != ""} {
  77.       PopError "$excuse\n$outp"
  78.     } else {
  79.       PopError "$outp"
  80.     }
  81.   } else {
  82.     PopError "$excuse"
  83.   }
  84.   return 1
  85. }
  86.  
  87. ShowWindow [lindex $argv 7] [lindex $argv 8]
  88. set glob(abortcmd) 0
  89. set config(ftp,timeout) [lindex $argv 2]
  90. set config(ftp,cache,maxentries) 1
  91. set ftp(cache) ""
  92. set ftp(cache,file) ""
  93. set config(dateformat) "yymmdd"
  94. eval FTP_Transfer $argv
  95.  
  96.